perm filename SAMO2.F4[P11,LCS]1 blob sn#430715 filedate 1979-04-04 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C       SAMO2    FOR INTERACTIVE USE.
C00005 ENDMK
CāŠ—;
C       SAMO2    FOR INTERACTIVE USE.
      SUBROUTINE SAMO2(IDSK,N)    
	COMMON I(1)  /ROUT/ROUT(1)  /FINOUT/JPEAK,IPEAK,NBUF
	1 /CONV/ICONV,INIOUT,JFLNM /IDEV/IDEV
      DIMENSION IDBUF(2048),JDBUF(512),NN(512),LDBUF(512)
 	EQUIVALENCE (IDBUF,JDBUF),(LDBUF,IDBUF(513))
C*** IDBUF WILL STORE PACKED SAMPLES. ****
	IF(INIOUT.EQ.0)GO TO 99
C NOW OPEN PROPER OUTPUT FILE
	INIOUT=0
	IDSK=0
	CALL PUTEXT('TEST','SND')
	NN(1)="525252525252
	NN(2)=I(4)
C I(4)=SRATE, I(8)=NCHNS(-1),  FOR NEXT, 0=12 BIT, 1=18 BIT SMPLS.
	NN(3)="3000001
	NN(4)=I(8)+1
  	NN(5)=32000
	DO 299 K=6,128
299	NN(K)=0
C	CALL FASTOU(NN,128)
	CALL EXTOUT(NN,128)
99    J=IDSK+1
	M1=1
      M2=0
      IDSK=IDSK+N
C  COUNTS SAMPLES TO DATE
      DO 1 K=J,IDSK
      IS=ROUT(M1+M2)
C  ****** REMOVE NEXT WHEN OTHER MODIFICATIONS HAVE BEEN MADE. ******
	IS=IS*16
C *16 TO CONVERT 12 BIT AMPL RANGE TO 16 BIT RANGE.
	IA=IABS(IS)
      IF(IA.GT.IPEAK)IPEAK=IA
      IDBUF(K)=IS
1     M2=M2+1
      IF(IDSK.LT.NBUF)RETURN
C NBUF=512,MONO   =1024,STEREO

	M=1
	J=NBUF/2
	DO 44 K=1,J
   	NN(K)=(IDBUF(M)*"1000000).OR.(IDBUF(M+1).AND."777777)

C  PACKS 2 SMPLS PER WORD.
CC	NN(K)=IDBUF(M)*262144+IDBUF(M+1)
C 16*262144=4194304
44	M=M+2

CZ     IF(MS(L).LT.0)MS(L)=4096+MS(L)
CZ      IDBUF(KL)=MS(3)+MS(2)*4096+MS(1)*16777216
C PACKS 3 SMPLS TO A 36-BIT WORD. 4096=2**12, 16---=2**24.
C  MS(1) HAS LEFT HAND 12 BITS; MS(2), MIDDLE 12 BITS; MS(3), RIGHT 12.
C  NEGATIVE NUMBERS RUN FROM 4095(I.E. -1) TO 2049(I.E. -2048).
C	CALL FASTOU(NN,J)
	CALL EXTOUT(NN,J)

10    J=IDSK-NBUF
      IF(J.LT.1)GO TO 4
      DO 5 K=1,J
5     IDBUF(K)=IDBUF(NBUF+K)
4     IDSK=J
      RETURN
      END